home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Utilities / Communications / Pancake Dev Package 1.0 / Test Extern / Test Extern.p < prev    next >
Encoding:
Text File  |  1995-09-06  |  4.4 KB  |  180 lines  |  [TEXT/PJMM]
  1. unit Editor;
  2. interface
  3.     uses
  4.         PancakeCommon;
  5.  
  6.     procedure MAIN (params: editParamsPtr);
  7.  
  8. implementation
  9.  
  10.     procedure MAIN (params: editParamsPtr);
  11.  
  12.         procedure Write (str: string);
  13.         begin
  14.             WriteProc(str, params^.procs[1]);
  15.         end;
  16.         procedure Writeln (str: string);
  17.         begin
  18.             WritelnProc(str, params^.procs[2]);
  19.         end;
  20.         procedure WriteHand (hand: Handle);
  21.         begin
  22.             WriteHandProc(hand, params^.procs[3]);
  23.         end;
  24.         procedure ListResFile (name: string);
  25.         begin
  26.             ListResFileProc(name, params^.procs[4]);
  27.         end;
  28.         procedure SetNodeAction (action: NodeActionType);
  29.         begin
  30.             SetNodeActionProc(action, params^.procs[5]);
  31.         end;
  32.         procedure RestoreNodeAction;
  33.         begin
  34.             RestoreNodeActionProc(params^.procs[6]);
  35.         end;
  36.         procedure JumpTo (x, y: integer);
  37.         begin
  38.             JumpToProc(x, y, params^.procs[7]);
  39.         end;
  40.         procedure Out (str: string);
  41.         begin
  42.             OutProc(str, params^.procs[8]);
  43.         end;
  44.         procedure OutPtr (buf: ptr; size: longint);
  45.         begin
  46.             OutPtrProc(buf, size, params^.procs[9]);
  47.         end;
  48.         procedure Report (where: integer; str: string);
  49.         begin
  50.             ReportProc(where, str, params^.procs[10]);
  51.         end;
  52.         function GetVarPtr (which: integer): ptr;
  53.         begin
  54.             GetVarPtr := GetVarPtrProc(which, params^.procs[11]);
  55.         end;
  56.         procedure ListHand (hand: handle);
  57.         begin
  58.             ListHandProc(hand, params^.procs[12]);
  59.         end;
  60.         function ListTextFile (pathname, filename: string): OSErr;
  61.         begin
  62.             ListTextFile := ListTextFileProc(pathname, filename, params^.procs[13]);
  63.         end;
  64.         procedure LettersPrompt (prompt, possible: string; len: byte);
  65.         begin
  66.             LettersPromptProc(prompt, possible, len, params^.procs[14]);
  67.         end;
  68.         procedure PasswordPrompt (prompt, possible: string; len: byte);
  69.         begin
  70.             PasswordPromptProc(prompt, possible, len, params^.procs[15]);
  71.         end;
  72.         procedure NumbersPrompt (prompt, possible: string; max: longint);
  73.         begin
  74.             NumbersPromptProc(prompt, possible, max, params^.procs[16]);
  75.         end;
  76.         procedure AutoPrompt (prompt, possible: string);
  77.         begin
  78.             AutoPromptProc(prompt, possible, params^.procs[17]);
  79.         end;
  80.         procedure YesNoPrompt (prompt: string; yesDefault: boolean);
  81.         begin
  82.             YesNoPromptProc(prompt, yesDefault, params^.procs[18]);
  83.         end;
  84.         procedure DatePrompt (prompt: string);
  85.         begin
  86.             DatePromptProc(prompt, params^.procs[19]);
  87.         end;
  88.         procedure PhonePrompt (prompt: string);
  89.         begin
  90.             PhonePromptProc(prompt, params^.procs[20]);
  91.         end;
  92.         procedure ClrScr;
  93.         begin
  94.             ClrScrProc(params^.procs[21]);
  95.         end;
  96.         function ReplacePercents (str: string; replaceProc: procPtr; user: userRecPtr): string;
  97.         begin
  98.             ReplacePercents := ReplacePercentsProc(str, replaceProc, user, params^.procs[22]);
  99.         end;
  100.         function HasAccess (acs: string): boolean;
  101.         begin
  102.             HasAccess := HasAccessProc(acs, params^.procs[23]);
  103.         end;
  104.         procedure SendFile (protocol: char; path, filename: string);
  105.         begin
  106.             SendFileProc(protocol, path, filename, params^.procs[24]);
  107.         end;
  108.         procedure ReceiveFile (protocol: char; path, filename: string; theRout: ProcPtr);
  109.         begin
  110.             ReceiveFileProc(protocol, path, filename, params^.procs[25]);
  111.         end;
  112.  
  113.         procedure DisposeExtern;
  114.         begin
  115.             with params^ do
  116.                 if privates <> nil then
  117.                     begin
  118.                         DisposeHandle(handle(privates));
  119.                         privates := nil;
  120.                         RestoreNodeAction;
  121.                     end;
  122.         end;
  123.  
  124.         procedure IdleExtern;
  125.         begin
  126.             with params^, privates^^ do
  127.                 begin
  128.                     case stage of
  129.                         Open: 
  130.                             begin
  131.                                 Writeln('Hey, this is an external, neato!');
  132.                                 Write(Return);
  133.                                 LettersPrompt('Enter some text: ', PossPrintable, 50);
  134.                                 stage := succ(stage);
  135.                             end;
  136.                         Quest: 
  137.                             begin
  138.                                 Writeln(concat(Return, 'You said "', curAnswer^, '"'));
  139.                                 stage := succ(stage);
  140.                             end;
  141.                         Exit: 
  142.                             begin
  143.                                 DisposeExtern;
  144.                             end;
  145.                     end;
  146.                 end;
  147.         end;
  148.  
  149.         procedure InitExtern;
  150.         begin
  151.             with params^ do
  152.                 begin
  153.                     privates := privatesHand(NewHandleClear(SizeOf(privatesRec)));
  154.                     HLockHi(handle(privates));
  155.                     with privates^^ do
  156.                         begin
  157.                             curAnswer := ptr2str(GetVarPtr(vCurAnswer));
  158.                             curCommand := ptr2str(GetVarPtr(vCurCommand));
  159.                             curParams := ptr2str(GetVarPtr(vCurParams));
  160.                             numParams := ptr2int(GetVarPtr(vNumParams));
  161.                             thisUser := ptr2userRec(GetVarPtr(vThisUser));
  162.                         end;
  163.                 end;
  164.         end;
  165.  
  166.     begin
  167.         if (params^.message <> DisposeGlobal) and (params^.privates = nil) then
  168.             InitExtern;
  169.         case params^.message of
  170.             Idle: 
  171.                 IdleExtern;
  172.             KeyPressed: 
  173.                 ;
  174.             DisposeExt: 
  175.                 DisposeExtern;
  176.             DisposeGlobal: 
  177.                 params^.globals := nil;
  178.         end;
  179.     end;
  180. end.